Syntax10.Scn.Fnt
FoldElems
Syntax10.Scn.Fnt
(*----------------------------------------------------------------
Xref creates a cross reference list for Oberon-2 programs.
Xref.List (^ | * | {filename} ~)
	opens a viewer showing the source text of the specified file(s) with linenumbers
	as well as a sorted list of names and the line numbers where they occur in the
	source text.
Xref.SetLineLength  number
	allows the user to specify the desired line length in characters. Default is 120.
Xref.SetNumberLength  number
	allows the user to specify the desired number of digits per line number in order
	to be able to print the line numbers in an aligned way. Default is 5.
----------------------------------------------------------------*)
Syntax10i.Scn.Fnt
StampElems
Alloc
8 May 95
Syntax10b.Scn.Fnt
Documentation
MODULE Xref;  (*HM  9 Feb 89 / 
IMPORT Viewers, MenuViewers, TextFrames, Texts, Oberon, Strings;
CONST
	hTabSize = 569;  (*hash table size: 4*i+3*)
	kTabSize = 45;  (*at most 45 keywords*)
	kln = 15;  (*max.length of a keyword*)
	Alfa = ARRAY kln OF CHAR;
	Ref = POINTER TO Item;
	Item = RECORD
		lno: INTEGER;
		next: Ref
	END;
	Word = RECORD
		key: Alfa;
		first: Ref
	END;
	HashTab = ARRAY hTabSize OF Word;  (*hash table*)
	w: Texts.Writer;
	nk: INTEGER;  (*nr.of keywords*)
	n: INTEGER;  (*current line number*)
	nopl: INTEGER;  (*nr.of line numbers per page*)
	llng: INTEGER;  (*line length*)
	dgpn: INTEGER;  (*digits per number*)
	key: ARRAY kTabSize OF Alfa;  (*keyword list*)
PROCEDURE InitTab; (*initialize keyword table*)
	PROCEDURE AddKey(s: ARRAY OF CHAR);
	BEGIN
		INC(nk); COPY(s, key[nk])
	END AddKey;
BEGIN
	nk:=0;
	AddKey("ARRAY");
	AddKey("BEGIN");
	AddKey("BOOLEAN");
	AddKey("CASE");
	AddKey("CHAR");
	AddKey("CLOSE");
	AddKey("CONST");
	AddKey("DEFINITION");
	AddKey("DIV");
	AddKey("DO");
	AddKey("ELSE");
	AddKey("ELSIF");
	AddKey("END");
	AddKey("EXIT");
	AddKey("FALSE");
	AddKey("IF");
	AddKey("IMPORT");
	AddKey("IN");
	AddKey("INTEGER");
	AddKey("IS");
	AddKey("LONGINT");
	AddKey("LONGREAL");
	AddKey("LOOP");
	AddKey("MOD");
	AddKey("MODULE");
	AddKey("NIL");
	AddKey("OF");
	AddKey("OR");
	AddKey("POINTER");
	AddKey("PROCEDURE");
	AddKey("REAL");
	AddKey("RECORD");
	AddKey("REPEAT");
	AddKey("RETURN");
	AddKey("SET");
	AddKey("SHORTINT");
	AddKey("THEN");
	AddKey("TO");
	AddKey("TRUE");
	AddKey("TYPE");
	AddKey("UNTIL");
	AddKey("VAR");
	AddKey("WHILE");
	AddKey("WITH")
END InitTab;
PROCEDURE OpenViewer(VAR lst: Texts.Text);
	VAR menu: Texts.Text; v: Viewers.Viewer; x, y: INTEGER;
BEGIN
	Oberon.AllocateUserViewer(0, x, y);
	v := MenuViewers.New(
		TextFrames.NewMenu("Xref.LST", "System.Close System.Copy System.Grow Edit.Store"),
		TextFrames.NewText(TextFrames.Text(""), 0), TextFrames.menuH, x, y);
	lst := v.dsc.next(TextFrames.Frame).text
END OpenViewer;
PROCEDURE WriteLnr;
BEGIN
	INC(n); Texts.WriteInt(w, n, 4); Texts.WriteString(w, "  ")
END WriteLnr;
PROCEDURE NoKey(id: ARRAY OF CHAR): BOOLEAN;
	VAR i, j, k: INTEGER;
BEGIN
	i:=0; j:=nk - 1;
	REPEAT
		k:=(i+j) DIV 2;
		IF id < key[k] THEN j:=k - 1 ELSE i:=k + 1 END
	UNTIL i > j;
	IF j < 0 THEN RETURN TRUE ELSE RETURN key[j] # id END
END NoKey;
PROCEDURE Search(id: ARRAY OF CHAR; VAR t: HashTab);
	VAR h, d, len: INTEGER; x: Ref;
BEGIN
	len:=Strings.Length(id);
	h:=(ORD(id[0]) + 17*ORD(id[len-1]) + len) * 7 MOD hTabSize;
	d:= - hTabSize;
	NEW(x); x.lno:=n;
	LOOP
		IF t[h].key[0] = 0X THEN  (*new entry*)
			COPY(id, t[h].key); t[h].first:=x; x.next:=NIL; EXIT
		ELSIF t[h].key = id THEN  (*found*)
			x.next:=t[h].first; t[h].first:=x; EXIT
		ELSE
			INC(d, 2); IF d = hTabSize THEN HALT(20) END;
			INC(h, ABS(d)); IF h >= hTabSize THEN DEC(h, hTabSize) END
		END
END Search;
PROCEDURE Sort(VAR t: HashTab; l, r: INTEGER);
	VAR i, j: INTEGER; x: Alfa; w: Word;
BEGIN
	i:=l; j:=r; x:=t[(i+j) DIV 2].key;
	REPEAT
		WHILE t[i].key < x DO INC(i) END;
		WHILE x < t[j].key DO DEC(j) END;
		IF i <= j THEN
			w:=t[i]; t[i]:=t[j]; t[j]:=w;
			INC(i); DEC(j)
		END
	UNTIL i > j;
	IF l < j THEN Sort(t, l, j) END;
	IF i < r THEN Sort(t, i, r) END
END Sort;
PROCEDURE PrintWord(word: Word);
	VAR i, l, wl: INTEGER; x, y, z: Ref;
BEGIN
	wl:=Strings.Length(word.key);
	Texts.WriteString(w, "  "); Texts.WriteString(w, word.key);
	i:=wl; WHILE i < kln DO Texts.Write(w, " "); INC(i) END;  (*fill with blanks*)
	x:=word.first; y:=x.next; x.next:=NIL;
	WHILE y # NIL DO  (*invert order of line numbers*)
		z:=y.next; y.next:=x; x:=y; y:=z
	END;
	l:=0; 
	REPEAT
		IF l = nopl THEN
			Texts.WriteLn(w); l:=0; i:=0; WHILE i < kln + 2 DO Texts.Write(w, " "); INC(i) END
		END;
		INC(l); Texts.WriteInt(w, x.lno, dgpn); x:=x.next
	UNTIL x = NIL;
	Texts.WriteLn(w)
END PrintWord;
PROCEDURE PrintTable(VAR t: HashTab);
	VAR i, m: INTEGER;
BEGIN  (*compress table*)
	m:=0; i:=0;
	WHILE i < hTabSize DO
		IF t[i].key[0] # 0X THEN t[m]:=t[i]; INC(m) END;
		INC(i)
	END;
	IF m > 0 THEN Sort(t, 0, m-1) END;
	nopl:=(llng-kln-2) DIV dgpn;
	i:=0; WHILE i < m DO PrintWord(t[i]); INC(i) END
END PrintTable;
PROCEDURE Process (src: Texts.Text);	(* marked viewer *)
	VAR r: Texts.Reader; lst: Texts.Text; t: HashTab; id: Alfa; ch, och: CHAR; level, k: INTEGER;
	PROCEDURE NextCh;
	BEGIN
		Texts.Write(w, ch); Texts.Read(r, ch)
	END NextCh;
BEGIN
	OpenViewer(lst);
	n:=0; WriteLnr; 
	k:=0; WHILE k < hTabSize DO t[k].key[0]:=0X; t[k].first:=NIL; INC(k) END;
	Texts.OpenReader(r, src, 0); Texts.Read(r, ch);
	WHILE ch # 0X DO
		CASE ch OF
			"A".."Z", "a".."z":
				k:=0;
				REPEAT
					IF k < kln THEN id[k]:=ch; INC(k) END;
					NextCh
				UNTIL ~ (((CAP(ch)>="A") & (CAP(ch)<="Z")) OR ((ch>="0") & (ch<="9")));
				IF k >= kln THEN k:=kln - 1 END; id[k]:=0X;
				IF NoKey(id) THEN Search(id, t) END
		|  "0".."9":
				REPEAT NextCh UNTIL (ch >= "9") OR (ch <= "0")
		| "'", 22X:
				och:=ch;
				LOOP
					NextCh; IF (ch = 0X) OR (ch = 0DX) THEN EXIT END;
					IF ch = och THEN NextCh; EXIT END
				END
		| 0DX:
				NextCh; WriteLnr
		|  "(":
				NextCh;
				IF ch = "*" THEN
					NextCh; level:=1;
					LOOP
						IF ch = 0X THEN EXIT
						ELSIF ch = 0DX THEN NextCh; WriteLnr
						ELSIF ch = "*" THEN
							NextCh;
							IF ch = ")" THEN 
								NextCh; DEC(level); 
								IF level = 0 THEN EXIT END
							END
						ELSIF ch = "(" THEN
							NextCh;
							IF ch = "*" THEN NextCh; INC(level) END
						ELSE NextCh
						END
					END  (*LOOP*)
				END
		ELSE
			NextCh
		END  (*CASE*)
	END;
	Texts.WriteLn(w); Texts.WriteLn(w);
	PrintTable(t);
	Texts.Append(lst, w.buf)
END Process;
PROCEDURE List*;
	VAR s: Texts.Scanner; src, t: Texts.Text; beg, end, time: LONGINT; v : Viewers.Viewer;
BEGIN
	Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
	IF (s.class = Texts.Char) & (s.c = "^") THEN
		Oberon.GetSelection(t, beg, end, time);
		IF time >= 0 THEN Texts.OpenScanner(s, t, beg); Texts.Scan(s) END
	END;
	IF (s.class = Texts.Char) & (s.c = "*") THEN
		v := Oberon.MarkedViewer(); src := v.dsc.next(TextFrames.Frame).text;
		Process(src)
	ELSE
		WHILE s.class = Texts.Name DO
			NEW(src); Texts.Open(src, s.s);
			Process(src);
			Texts.Scan(s)
		END
END List;
PROCEDURE IntPar(min, max: LONGINT): INTEGER;
	VAR par: Oberon.ParList; s: Texts.Scanner; i: LONGINT;
BEGIN
	par:=Oberon.Par; Texts.OpenScanner(s, par.text, par.pos); Texts.Scan(s);
	IF s.class = 3 THEN i:=s.i ELSE i:=0 END;
	IF i < min THEN i:=min ELSIF i > max THEN i:=max END;
	RETURN SHORT(i)
END IntPar;
PROCEDURE SetLineLength*;	(* number *)
BEGIN
	llng:=IntPar(kln + dgpn + 1, 120)
END SetLineLength;
PROCEDURE SetNumberLength*;	(* number *)
BEGIN
	dgpn:=IntPar(0, 5)
END SetNumberLength;
BEGIN
	Texts.OpenWriter(w); llng:=100; dgpn:=5; InitTab
END Xref.